home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1857 / 1857sr~1.zoo / lisp / case-table.el next >
Encoding:
Text File  |  1992-01-24  |  6.8 KB  |  214 lines
  1. ;; Functions for extending the character set and dealing with case tables.
  2. ;; Copyright (C) 1987, 1990 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21.  
  22. ;; Written by:
  23. ;; Howard Gayle
  24. ;; TN/ETX/TT/HL
  25. ;; Ericsson Telecom AB
  26. ;; S-126 25 Stockholm
  27. ;; Sweden
  28. ;; howard@ericsson.se
  29. ;; uunet!ericsson.se!howard
  30. ;; Phone: +46 8 719 5565
  31. ;; FAX  : +46 8 719 8439
  32.  
  33. (require 'text-mode)
  34.  
  35. (defun case-of (ch ct)
  36.    "Return 'nocase if character CH is marked as caseless in
  37. case table CT, 'lowercase for lower case, and 'uppercase for
  38. upper case."
  39.    (cond
  40.       ((nocase-p ch ct) 'nocase)
  41.       ((lower-p  ch ct) 'lowercase)
  42.       (t                'uppercase)
  43.    )
  44. )
  45.  
  46. (defun describe-buffer-case-table ()
  47.    "Describe the case table of the current buffer."
  48.    (interactive)
  49.    (describe-case-table (case-table))
  50. )
  51.  
  52. (defun describe-case-table (ct)
  53.    "Describe the given case table in a help buffer."
  54.    (let* (
  55.            (i 0)                   ; First character in range.
  56.      (ic (case-of 0 ct)) ; Case of i.
  57.      (j 0)                   ; Last character in range.
  58.      (jc ic)              ; Case of j.
  59.      (k 1)                   ; Current character.
  60.      kc                      ; Case of k.
  61.            )
  62.       (with-output-to-temp-buffer "*Help*"
  63.      (while (<= k 255)
  64.         (setq kc (case-of k ct))
  65.         (if (not (eq jc kc))
  66.            (progn
  67.           (describe-character i)
  68.           (if (not (= i j))
  69.              (progn
  70.                  (princ "..")
  71.             (describe-character j)
  72.              )
  73.           )
  74.           (princ "\t")
  75.           (princ (symbol-name jc))
  76.           (princ "\n")
  77.           (setq i k)
  78.           (setq ic kc)
  79.            )
  80.         )
  81.         (if (= k 255)
  82.            (progn
  83.           (describe-character i)
  84.           (if (not (= i k))
  85.              (progn
  86.                  (princ "..")
  87.             (describe-character k)
  88.              )
  89.           )
  90.           (princ "\t")
  91.           (princ (symbol-name kc))
  92.           (princ "\n")
  93.            )
  94.         )
  95.         (setq j k)
  96.         (setq jc kc)
  97.         (setq k (1+ k))
  98.      )
  99.      (print-help-return-message)
  100.       )
  101.    )
  102. )
  103.  
  104. (defun describe-character (c)
  105.    "Print character C readably."
  106.    (cond
  107.       ((= c ?\t) (princ "\\t"))
  108.       ((= c ?\n) (princ "\\n"))
  109.       (t (princ (char-to-string c)))
  110.    )
  111. )
  112.  
  113. (defun invert-case ()
  114.    "Change the case of the character just after point."
  115.    (interactive "*")
  116.    (let  (
  117.            (oc (following-char)) ; Old character.
  118.            )
  119.       (cond
  120.            ((lower-p oc) (replace-char (upcase   oc)))
  121.            ((upper-p oc) (replace-char (downcase oc)))
  122.       )
  123.    )
  124.    (forward-char)
  125. )
  126.  
  127. (defun standard-case-syntax-delims (l r)
  128.    "Set the entries for characters L and R in standard-case-table,
  129. standard-downcase-table, standard-upcase-table,
  130. standard-syntax-table, and text-mode-syntax-table to indicate
  131. left and right delimiters."
  132.    (set-case-table-nocase l (standard-case-table))
  133.    (set-case-table-nocase r (standard-case-table))
  134.    (set-trans-table-to l l (standard-downcase-table))
  135.    (set-trans-table-to r r (standard-downcase-table))
  136.    (set-trans-table-to l l (standard-upcase-table))
  137.    (set-trans-table-to r r (standard-upcase-table))
  138.    (modify-syntax-entry l
  139.       (concat "(" (char-to-string r) "  ") (standard-syntax-table))
  140.    (modify-syntax-entry l
  141.       (concat "(" (char-to-string r) "  ") text-mode-syntax-table)
  142.    (modify-syntax-entry r
  143.       (concat ")" (char-to-string l) "  ") (standard-syntax-table))
  144.    (modify-syntax-entry r
  145.       (concat ")" (char-to-string l) "  ") text-mode-syntax-table)
  146. )
  147.  
  148. (defun standard-case-syntax-pair (uc lc)
  149.    "Set the entries for characters UC and LC in
  150. standard-case-table, standard-downcase-table,
  151. standard-upcase-table, standard-case-fold-table, standard-syntax-table, and
  152. text-mode-syntax-table to indicate an (uppercase, lowercase)
  153. pair of letters."
  154.    (set-case-table-pair lc uc (standard-case-table))
  155.    (set-trans-table-to lc lc (standard-downcase-table))
  156.    (set-trans-table-to uc lc (standard-downcase-table))
  157.    (set-trans-table-to lc uc (standard-upcase-table))
  158.    (set-trans-table-to uc uc (standard-upcase-table))
  159.    (modify-syntax-entry lc "w   " (standard-syntax-table))
  160.    (modify-syntax-entry lc "w   " text-mode-syntax-table)
  161.    (modify-syntax-entry uc "w   " (standard-syntax-table))
  162.    (modify-syntax-entry uc "w   " text-mode-syntax-table)
  163. )
  164.  
  165. (defun standard-case-syntax-punct (c)
  166.    "Set the entries for character C in standard-case-table,
  167. standard-downcase-table, standard-upcase-table,
  168. standard-syntax-table, and text-mode-syntax-table to indicate
  169. punctuation."
  170.    (set-case-table-nocase c (standard-case-table))
  171.    (set-trans-table-to c c (standard-downcase-table))
  172.    (set-trans-table-to c c (standard-upcase-table))
  173.    (modify-syntax-entry c ".   " (standard-syntax-table))
  174.    (modify-syntax-entry c ".   " text-mode-syntax-table)
  175. )
  176.  
  177. (defun standard-case-syntax-symb (c)
  178.    "Set the entries for character C in standard-case-table,
  179. standard-downcase-table, standard-upcase-table,
  180. standard-syntax-table, and text-mode-syntax-table to indicate a
  181. symbol."
  182.    (set-case-table-nocase c (standard-case-table))
  183.    (set-trans-table-to c c (standard-downcase-table))
  184.    (set-trans-table-to c c (standard-upcase-table))
  185.    (modify-syntax-entry c "_   " (standard-syntax-table))
  186.    (modify-syntax-entry c "_   " text-mode-syntax-table)
  187. )
  188.  
  189. (defun standard-case-syntax-white (c)
  190.    "Set the entries for character C in standard-case-table,
  191. standard-downcase-table, standard-upcase-table,
  192. standard-syntax-table, and text-mode-syntax-table to indicate
  193. white space."
  194.    (set-case-table-nocase c (standard-case-table))
  195.    (set-trans-table-to c c (standard-downcase-table))
  196.    (set-trans-table-to c c (standard-upcase-table))
  197.    (modify-syntax-entry c "    " (standard-syntax-table))
  198.    (modify-syntax-entry c "    " text-mode-syntax-table)
  199. )
  200.  
  201. (defun standard-case-syntax-word (c)
  202.    "Set the entries for character C in standard-case-table,
  203. standard-downcase-table, standard-upcase-table,
  204. standard-syntax-table, and text-mode-syntax-table to indicate a
  205. word component."
  206.    (set-case-table-nocase c (standard-case-table))
  207.    (set-trans-table-to c c (standard-downcase-table))
  208.    (set-trans-table-to c c (standard-upcase-table))
  209.    (modify-syntax-entry c "w   " (standard-syntax-table))
  210.    (modify-syntax-entry c "w   " text-mode-syntax-table)
  211. )
  212.  
  213. (provide 'case-table)
  214.